home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / lzhuftp5.zip / LZ.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-14  |  2KB  |  77 lines
  1. {$A+,B-,D+,E+,F-,I-,L+,N+,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3. program LZH_Test;
  4. uses
  5.   LZH;
  6. type
  7.   IObuf = array[0..10*1024-1] of byte;
  8. var
  9.   infile,outfile: file;
  10.   ibuf,obuf: IObuf;
  11.   s: String;
  12.  
  13.   procedure Error (msg: String);
  14.   begin
  15.     writeln(msg);
  16.     HALT(1)
  17.   end;
  18.  
  19. {$F+}
  20.   procedure ReadNextBlock;
  21. {$F-}
  22.   begin
  23.     inptr:= 0;
  24.     BlockRead(infile,inbuf^,sizeof(ibuf),inend);
  25.     if IoResult>0 then Error('! Error reading input file');
  26.   end;
  27.  
  28. {$F+}
  29.   procedure WriteNextBlock;
  30. {$F-}
  31.   var
  32.     wr: word;
  33.   begin
  34.     BlockWrite(outfile,outbuf^,outptr,wr);
  35.     if (IoResult>0) or (wr<outptr) then
  36.       Error('! Error writing output file');
  37.     outptr:= 0
  38.   end;
  39.  
  40.   procedure OpenInput (fn: String);
  41.   begin
  42.     assign(infile,fn); reset(infile,1);
  43.     if IoResult>0 then Error('! Can''t open input file');
  44.     inbuf:= @ibuf;
  45.     ReadToBuffer:= ReadNextBlock;
  46.     ReadToBuffer;
  47.   end;
  48.  
  49.   procedure OpenOutput (fn: String);
  50.   begin
  51.     assign(outfile,fn); rewrite(outfile,1);
  52.     if IoResult>0 then Error('! Can''t open output file');
  53.     outbuf:= @obuf;
  54.     outend:= sizeof(obuf);
  55.     outptr:= 0;
  56.     WriteFromBuffer:= WriteNextBlock;
  57.   end;
  58.  
  59. begin {main}
  60.    if ParamCount<>3 then begin
  61.      writeln('Usage: lzhuf e(compression)|d(uncompression) infile outfile');
  62.      HALT(1)
  63.    end;
  64.    OpenInput(ParamStr(2));
  65.    OpenOutput(ParamStr(3));
  66.    s:= ParamStr(1);
  67.    case s[1] of
  68.      'e','E': Encode(filesize(infile));
  69.      'd','D': Decode
  70.    else
  71.      Error('! Use [D] for Decompression or [E] for Compression')
  72.    end;
  73.    close(infile); if IoResult>0 then Error('! Error closing input file');
  74.    if outptr>0 then WriteNextBlock;
  75.    close(outfile); if IoResult>0 then Error('! Error closing output file');
  76. end.
  77.